(** Module Ostap
 *
 *  Author: Jk
 *)

open IL
open Misc
open Generation

let genExpr e  = String.concat " " (List.map Source.toString e)

let genPatt = genExpr

let printNotSupported text = print_string ("Warning! " ^ text ^ " not supported\n")

open Production

let rec genProduct indent = 
    let indent' = indent ^ "  " in
    let unary name r = sprintf "(Ostap.%s %s)" name (genProduct indent r) in
    let defAction seq = 
       let rec loop n = function
        [] -> []
       |h::t -> if h.omit then loop (n + 1) t else n :: loop (n + 1) t
       in 
       String.concat "," (List.map (sprintf "_%d") (loop 1 seq))
    in
    function
    PAlt (l,r) -> 
      let l' = genProduct indent' l
      and r' = genProduct indent' r
      in sprintf "Ostap.alt\n%s(%s)\n%s(%s)" indent' l' indent' r'
    |PToken t -> getText t
    |POpt r  -> unary "opt"  r 
    |PSome r -> unary "some" r
    |PMany r -> unary "many" r
    |PSeq (seq,a) ->  
     let elem e = genProduct indent' e.rule in
     let rec genList = function
       [] -> ""
       | h::t -> 
         let h' = elem h in
         match t with 
         [] -> h'
         | _ -> sprintf "(Ostap.seq %s %s)" h' (genList t)
     in
     let actExpr = if a = None then defAction seq else genOpt getText a in
     let binds = "some shit" in
     sprintf "(Ostap.apply (fun %s -> %s) %s)" binds actExpr (genList seq)
    |PRef (r,p) -> sprintf "(%s %s)" (getText r) (genOpt getText p)
    |PLiteral r -> getText r
    |PMetaRef (_,_,_) -> ( printNotSupported "Meta-rules"; "")

let checkMetaArgs = function
    |[] -> ()
    | _  -> printNotSupported "Meta-rules"

let genRule r = 
    let body = genProduct " " r.Rule.body in    
    ( checkMetaArgs r.Rule.metaArgs
    ; sprintf "%s = fun %s -> %s" r.Rule.name (genPatt r.Rule.args) body
    )

let genGrammar g = 
    let rules = String.concat "\n and " (List.map genRule g) in
    sprintf "let rec %s" rules

let generator conf x =
    let oname = getMandatoryStringOption conf "o" in 
    let text  = sprintf "(* generated with YARD (%s@%s) *)\n%s\n%s\n%s"
                 Version.version 
                 Version.date 
                 (genOpt Source.toString x.Definition.head) 
                 (genGrammar x.Definition.grammar) 
                 (genOpt Source.toString x.Definition.foot)
    in 
    let ochan = open_out_bin oname in
    output_string ochan text

let registerOptions = 
    Settings.customize (Settings.empty())
    [  "o", Settings.String, Settings.Mandatory, " fname\t-output file name"] 
    (fun () -> [])
